{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
module Handler.MasterCatalog.QueryGuide where

import Foundation

import Settings.StaticFiles

import Handler.MasterCatalog.Object ( getObjects )
import Handler.Types                ( Star(..), Instrument(..), Ra, Dec, Mag, Ang )

import Geometry.Geometry
import Geometry.FocalPlane
import Geometry.FPlaneVisibility
import Geometry.Intersection

import qualified Data.IntMap as M

import Control.Monad
import Data.VectorSpace
import Data.AffineSpace
import Text.Printf(printf)
import Data.Text.Read (rational)
import Data.List ((\\), sortBy)

import Control.Monad.Trans.Maybe

import Database.Persist.Base
--import Database.Persist.GenericSql (SqlPersist)
import Database.Persist.GenericSql.Raw (withStmt)

import qualified Data.Map as Map

centreMass xs = foldr(^+^) (0,0) xs ^/ fromIntegral (length xs)

getGuideInfo :: Instrument -> (Mag,Mag) -> Ra -> Dec -> Handler (Maybe (Ang,[Star]))
getGuideInfo inst (min,max) ra dec = do
  
  mr <- getStars inst (min,max) ra dec

  case mr of
   Just (ang, xs, _) -> do
                          let ss = map (\x -> Star (ra5 x) (dec5 x) (mag5 x)) xs
                          return $ Just (ang * 180/pi, ss)
   Nothing           -> do
                          return Nothing

getStars device (mag1,mag2) alpha delta = do
  ps <- getObjects (\s -> mag s >= mag1 && mag s <= mag2) (alpha,delta,radiusFieldOfView)
  liftIO $ print $ length ps
  let stars = M.fromList $ zip [1..] ps 
--      ts = zip [1..] $ [(-68.88605845568807,15.437068550757385)]
      ts = zip [1..] $ 
           map (^* focalScale) $ 
           map (\(x,y,z) -> (y,z)) $ 
           map r $ 
           map (\s -> fromPolar3D (1, (toRadian $ ra s), (toRadian $ dec s))) ps
      r  = rotateAxis (toRadian delta) (0,1,0) . rotateAxis (-(toRadian alpha)) (0,0,1)
      polygons = map (translate (negateV $ getDeviceVector device)) guides
      vs  = optimizeAngle ts polygons
  case vs of
    Nothing -> return Nothing
    Just (a,xs) -> do
      let rs  = ts \\ xs 
          h   = map (translate (rotate (-a) $ getDeviceVector device) . snd)
          g   = zipWith (\a b -> P5 {ra5=ra a, dec5 = dec a, mag5 = mag a, x5 = 250 + fst b, y5 = 250 - snd b})
          f   = map (\i -> stars M.! i) . map fst
      return $ Just (a, g (f xs) (h xs), g (f rs) (h rs))


{--
getObjects2 f (longitude,latitude,r) = do
  let sql = "SELECT * FROM master_catalog WHERE q3c_radial_query(ra, dec, ?, ?, ?)"
      params = map PersistDouble [longitude,latitude,r]

  r <- getStars UVES (3,15) longitude latitude
 
  m <- case r of
          Nothing         -> return $ Map.empty
          Just (_, xs, _) -> return $ Map.fromList $ map (\x -> ((ra5 x, dec5 x, mag5 x),1) ) xs

  runDB $ withStmt sql params (withPopper2 m f)

withPopper2 m f popper = loop where
  loop = do
    mrow <- popper
    case mrow of
      Nothing -> return []
      Just (x:y:z:_) -> do
        let (PersistDouble ra) = x
            (PersistDouble dec) = y
            (PersistDouble mag) = z
            g = case (Map.lookup (ra,dec,mag) m) of
                 Nothing -> 0
                 Just _  -> 1

            obj = Star ra dec mag
        case f obj of
          True -> do
            xs <- loop
            return (obj:xs)
          False -> loop
--}

parseDevice = do
  v <- lookupGetParam "dev"
  case v of
    Nothing -> invalidArgs ["Inavalid bbox"]
    Just v  -> case v of 
      "uves"  -> return UVES
      "vuves" -> return VUVES
      "lss"   -> return LSS
      "issis"   -> return ISSIS

parseAngle s = do
  v <- lookupGetParam s
  case v of
    Nothing -> invalidArgs ["Invalidargs"]
    Just v  -> case rational v of
      Left  e -> invalidArgs ["Invalidargs"]
      Right x -> return (fst x)

parseAlpha = parseAngle "a"
parseDelta = parseAngle "d"

getMCGuide :: Handler RepHtml
getMCGuide = do
  defaultLayout $ [whamlet| <p> Введите центр поля зрения и выберите прибор.
                            <form name="input" action="@{MCQueryGuide}" method="get">
                               RA (град.): <input type="text" name="a"/><br>
                               DEC (град.): <input type="text" name="d"/><br>
                               Инструмент: <br>
                               <input type="radio" name="dev" value="uves" checked /> UVES <br>
                               <input type="radio" name="dev" value="vuves" /> VUVES <br>
                               <input type="radio" name="dev" value="lss" /> LSS <br>
                               <input type="radio" name="dev" value="issis" /> ISSIS <br>
                               <input type="submit" value="Выбрать" />
                  |]

defaultLayout1 widget = do
   mmsg <- getMessage
   pc <- widgetToPageContent $ do
      widget
      addCassius $(cassiusFile "default-layout")
   hamletToRepHtml $(hamletFile "default-layout1")

data P5 = P5 { ra5  :: Double
             , dec5 :: Double
             , mag5 :: Double
             , x5   :: Double
             , y5   :: Double }


getMCQueryGuide :: Handler RepHtml
getMCQueryGuide = do
  alpha  <- parseAlpha
  delta  <- parseDelta
  device <- parseDevice 
  v <- getStars device (3,15) alpha delta
  case v of
    Nothing -> noStars
    Just (a, xs, ps) -> stars a xs ps
  where
    format x = printf "%0.3f" x :: String
    noStars = defaultLayout1 $ do
      setTitle "Guide Stars"
      [whamlet| <p> Подходящих звезд для гидирования не найдено |]
    stars a ts ps = defaultLayout1 $ do
      let a1 = format (a*180/pi)
          ts' = sortBy (\a b -> compare (mag5 a) (mag5 b)) ts
      setTitle "Guide Stars"
      addScript $ StaticR js_raphael1_js
      addScript $ StaticR js_jquery_js
      addScript $ StaticR js_ourscript_js
      [whamlet| <p> Угол ориентации оси телескопа: <span id="axis_angle">#{a1}
                <table border="1" id="stars">
                  <tbody>
                     <tr>
                       <td>Ra
                       <td>Dec                       
                       <td>Mag                       
                       <td>X
                       <td>Y
                       $forall s <- ts'
                           <tr>
                             <td id="ra">#{format $ ra5 s}
                             <td id="dec">#{format $ dec5 s}
                             <td id="mag">#{format $ mag5 s}
                             <td id="x">#{format $ x5 s}
                             <td id="y">#{format $ y5 s}
                <div id="canvas_container">
                <table id="stars1" style="visibility:hidden">
                  <tbody>
                     $forall x <- ps
                       <tr>
                         <td id="ra">#{format $ ra5 x}
                         <td id="dec">#{format $ dec5 x}
                         <td id="mag">#{format $ mag5 x}
                         <td id="x">#{format $ x5 x}
                         <td id="y">#{format $ y5 x}
      |]
